home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SORTING.SWG / 0032_Various SORT Methods.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-31  |  6KB  |  177 lines
  1. const
  2.   MaxItem = 30000;
  3.  
  4. type
  5.   Item = word;
  6.   Ar1K = array[1..MaxItem] of Item;
  7.  
  8.  
  9.   (***** Selection sort routine.                                      *)
  10.   (*                                                                  *)
  11.   procedure SelectionSort ({update} var Data : Ar1K;
  12.                            {input }     ItemsToSort : word);
  13.   var
  14.     Temp   : Item;
  15.     Min,
  16.     Index1,
  17.     Index2 : word;
  18.   begin
  19.     for Index1 := 1 to pred(ItemsToSort) do
  20.       begin
  21.         Min := Index1;
  22.         for Index2 := succ(Index1) to ItemsToSort do
  23.           if Data[Index2] < Data[Min] then
  24.             Min := Index2;
  25.         Temp := Data[Min];
  26.         Data[Min] := Data[Index1];
  27.         Data[Index1] := Temp
  28.       end
  29.   end;        (* SelectionSort.                                       *)
  30.  
  31.  
  32.   (***** Insertion sort routine.                                      *)
  33.   (*                                                                  *)
  34.   procedure InsertionSort ({update} var Data : Ar1K;
  35.                            {input }     ItemsToSort : word);
  36.   var
  37.     Temp   : Item;
  38.     Index1,
  39.     Index2 : word;
  40.   begin
  41.     for Index1 := 2 to ItemsToSort do
  42.       begin
  43.         Temp := Data[Index1];
  44.         Index2 := Index1;
  45.         while (Data[pred(Index2)] > Temp) do
  46.           begin
  47.             Data[Index2] := Data[pred(Index2)];
  48.             dec(Index2)
  49.           end;
  50.         Data[Index2] := Temp
  51.       end
  52.   end;        (* InsertionSort.                                       *)
  53.  
  54.  
  55.   (***** Bubble sort routine.                                         *)
  56.   (*                                                                  *)
  57.   procedure BubbleSort ({update} var Data : Ar1K;
  58.                         {input }     ItemsToSort : word);
  59.   var
  60.     Temp   : Item;
  61.     Index1,
  62.     Index2 : word;
  63.   begin
  64.     for Index1 := ItemsToSort downto 1 do
  65.       for Index2 := 2 to Index1 do
  66.         if (Data[pred(Index2)] > Data[Index2]) then
  67.           begin
  68.             Temp := Data[pred(Index2)];
  69.             Data[pred(Index2)] := Data[Index2];
  70.             Data[Index2] := Temp
  71.           end
  72.   end;        (* BubbleSort.                                          *)
  73.  
  74.   (***** Shell sort routine.                                          *)
  75.   (*                                                                  *)
  76.   procedure ShellSort ({update} var Data : Ar1K;
  77.                        {input }     ItemsToSort : word);
  78.   var
  79.     Temp   : Item;
  80.     Index1, Index2, Index3 : word;
  81.   begin
  82.     Index3 := 1;
  83.     repeat
  84.       Index3 := succ(3 * Index3)
  85.     until (Index3 > ItemsToSort);
  86.     repeat
  87.       Index3 := (Index3 div 3);
  88.       for Index1 := succ(Index3) to ItemsToSort do
  89.         begin
  90.           Temp := Data[Index1];
  91.           Index2 := Index1;
  92.           while (Data[(Index2 - Index3)] > Temp) do
  93.             begin
  94.               Data[Index2] := Data[(Index2 - Index3)];
  95.               Index2 := (Index2 - Index3);
  96.               if (Index2 <= Index3) then
  97.                 break
  98.             end;
  99.           Data[Index2] := Temp
  100.         end
  101.     until (Index3 = 1)
  102.   end;        (* ShellSort.                                           *)
  103.  
  104.  
  105.   (***** QuickSort routine.                                           *)
  106.   (*                                                                  *)
  107.   procedure QuickSort({update} var Data : Ar1K;
  108.                       {input }     Left,
  109.                                    Right : word);
  110.   var
  111.     Temp   : Item;
  112.     Index1, Index2, Pivot  : word;
  113.   begin
  114.     Index1 := Left;
  115.     Index2 := Right;
  116.     Pivot := Data[(Left + Right) div 2];
  117.     repeat
  118.       while (Data[Index1] < Pivot) do
  119.         inc(Index1);
  120.       while (Pivot < Data[Index2]) do
  121.         dec(Index2);
  122.       if (Index1 <= Index2) then
  123.         begin
  124.           Temp := Data[Index1];
  125.           Data[Index1] := Data[Index2];
  126.           Data[Index2] := Temp;
  127.           inc(Index1);
  128.           dec(Index2)
  129.         end
  130.       until (Index1 > Index2);
  131.       if (Left < Index2) then
  132.         QuickSort(Data, Left, Index2);
  133.       if (Index1 < Right) then
  134.         QuickSort(Data, Index1, Right)
  135.   end;        (* QuickSort.                                           *)
  136.  
  137.   (***** Radix Exchange sort routine.                                 *)
  138.   (*                                                                  *)
  139.   procedure RadixExchange ({update} var Data   : ar1K;
  140.                            {input }     ItemsToSort,
  141.                                         Left,
  142.                                         Right  : word;
  143.                                         BitNum : shortint);
  144.   var
  145.     Temp   : Item;
  146.     Index1, Index2 : word;
  147.   begin
  148.     if (Right > Left) and ( BitNum >= 0) then
  149.       begin
  150.         Index1 := Left;
  151.         Index2 := Right;
  152.         repeat
  153.           while (((Data[Index1] shr BitNum) AND 1) = 0)
  154.           and (Index1 < Index2) do
  155.             inc(Index1);
  156.           while (((Data[Index2] shr BitNum) AND 1) = 1)
  157.           and (Index1 < Index2) do
  158.             dec(Index2);
  159.           Temp := Data[Index1];
  160.           Data[Index1] := Data[Index2];
  161.           Data[Index2] := Temp
  162.         until (Index2 = Index1);
  163.         if (((Data[Right] shr BitNum) AND 1) = 0) then
  164.           inc(Index2);
  165.         RadixExchange(Data, ItemsToSort, Left, pred(Index2),
  166.                       pred(BitNum));
  167.         RadixExchange(Data, ItemsToSort, Index2, Right, pred(BitNum))
  168.       end
  169.   end;        (* RadixExchange.                                       *)
  170.  
  171.  
  172. (*
  173.                                - Guy
  174. ---
  175.  ■ DeLuxe²/386 1.25 #5060 ■
  176.  
  177. *)